﻿#VisualFreeBasic_Form#  Version=5.6.2
Locked=0

[Form]
Name=BugReport
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=
WinStyle=WS_CAPTION,WS_SYSMENU,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_VISIBLE,WS_EX_WINDOWEDGE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_EX_TOPMOST,WS_POPUP
Style=3 - 常规窗口
Icon=
Caption=出错报告！
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=419
Height=342
TopMost=True
Child=False
MdiChild=False
TitleBar=True
SizeBox=False
SysMenu=True
MaximizeBox=False
MinimizeBox=False
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Label]
Name=Label1
Index=-1
Style=0 - 无边框
Caption=:(
Enabled=True
Visible=True
ForeColor=&HFF0000FF
BackColor=SYS,25
Font=Segoe Condensed,72,1
TextAlign=4 - 置中
Prefix=True
Ellipsis=False
Left=-1
Top=-16
Width=117
Height=135
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label2
Index=-1
Style=0 - 无边框
Caption=非常遗憾！软件崩溃了。
Enabled=True
Visible=True
ForeColor=&HFFFF0000
BackColor=SYS,25
Font=微软雅黑,16,1
TextAlign=1 - 居中
Prefix=True
Ellipsis=False
Left=129
Top=9
Width=270
Height=35
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label3
Index=-1
Style=0 - 无边框
Caption=本软件发生严重而不可逆的错误，我们对此引起的不便表示抱歉。是由某个未知的代码错误引起，俗称“BUG”
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,12
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=116
Top=44
Width=283
Height=67
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[TextBox]
Name=Text3
Index=-1
Style=3 - 凹边框
TextScrollBars=0 - 无滚动条
Text=
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=True
Multiline=False
Uppercase=False
Lowercase=False
Number=False
AutoHScroll=True
AutoVScroll=False
Left=76
Top=118
Width=331
Height=24
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[TextBox]
Name=Text1
Index=-1
Style=3 - 凹边框
TextScrollBars=1 - 垂直滚动条
Text=在这里输入发生BUG前的状态，描述引发BUG前的操作，以助勇芳能查明原因而可以修复BUG。查BUG是非常困难的事情，请详细描述才有可能查到BUG而修复它。
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,16
BackColor=SYS,5
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=True
Multiline=True
Uppercase=False
Lowercase=False
Number=False
AutoHScroll=False
AutoVScroll=True
Left=6
Top=146
Width=399
Height=57
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=提交BUG
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=319
Top=210
Width=87
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label4
Index=-1
Style=0 - 无边框
Caption=一键提交BUG报告给勇芳软件，以便勇芳能修复BUG
Enabled=True
Visible=True
ForeColor=SYS,17
BackColor=SYS,25
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=12
Top=221
Width=322
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Line]
Name=Line1
Index=-1
Style=0 - 顶部
BorderWidth=1
ArrowStartW=0 - 无箭头
ArrowStartH=0 - 无箭头
ArrowEndW=0 - 无箭头
ArrowEndH=0 - 无箭头
BorderColor=&HFF000000
Enabled=True
Visible=True
Left=-2
Top=113
Width=431
Height=10
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command2
Index=-1
Caption=继续执行
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=319
Top=249
Width=87
Height=23
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label5
Index=-1
Style=0 - 无边框
Caption=跳过出错代码继续执行，此方法有风险，不推荐使用
Enabled=True
Visible=True
ForeColor=SYS,17
BackColor=SYS,25
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=12
Top=254
Width=318
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command3
Index=-1
Caption=查看报告
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=319
Top=279
Width=87
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label6
Index=-1
Style=0 - 无边框
Caption=查看BUG报告，此报告是发送给勇芳研究BUG用。
Enabled=True
Visible=True
ForeColor=SYS,17
BackColor=SYS,25
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=12
Top=290
Width=318
Height=18
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[TextBox]
Name=Text2
Index=-1
Style=3 - 凹边框
TextScrollBars=3 - 垂直和水平
Text=
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,15
Font=新宋体,9
TextAlign=0 - 左对齐
PasswordChar=
Locked=True
HideSelection=True
Multiline=True
Uppercase=False
Lowercase=False
Number=False
AutoHScroll=True
AutoVScroll=True
Left=10
Top=321
Width=396
Height=302
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[Label]
Name=Label7
Index=-1
Style=0 - 无边框
Caption=联系方式：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=12
Top=123
Width=75
Height=14
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False


[AllCode]
'使用例题：
'Function Form1_VEH1_VectExcepHandler(ByRef excp As EXCEPTION_POINTERS)As Integer  '向量化异常处理（程序崩溃后处理）
'   '整个软件，只需一个VEH即可，在主窗口放置控件，所有窗口、模块、多线程等发生崩溃，都会跑到这里执行。
'   Select Case excp.ExceptionRecord->ExceptionCode   '发生异常的原因。这是由硬件异常生成的代码，或在RaiseException函数中为软件生成的异常指定的代码 。
'      Case EXCEPTION_ACCESS_VIOLATION         'ErrStr = "线程试图读取或写入对其没有适当访问权限的虚拟地址。"
'      Case EXCEPTION_ARRAY_BOUNDS_EXCEEDED    'ErrStr = "线程尝试访问超出范围的数组元素，并且基础硬件支持范围检查。"
'      Case EXCEPTION_BREAKPOINT               'ErrStr = "遇到断点。"
'      Case EXCEPTION_DATATYPE_MISALIGNMENT    'ErrStr = "线程试图读取或写入在不提供对齐方式的硬件上未对齐的数据。例如，必须在2字节边界上对齐16位值；4字节边界上的32位值，依此类推。"
'      Case EXCEPTION_FLT_DENORMAL_OPERAND     'ErrStr = "浮点运算中的操作数之一是非正规的。非标准值是一个太小而无法表示为标准浮点值的值。"
'      Case EXCEPTION_FLT_DIVIDE_BY_ZERO       'ErrStr = "线程试图将浮点值除以零的浮点除数。"
'      Case EXCEPTION_FLT_INEXACT_RESULT       'ErrStr = "浮点运算的结果不能完全表示为小数。"
'      Case EXCEPTION_FLT_INVALID_OPERATION    'ErrStr = "此异常表示此列表中未包含的任何浮点异常。"
'      Case EXCEPTION_FLT_OVERFLOW             'ErrStr = "浮点运算的指数大于相应类型所允许的大小。"
'      Case EXCEPTION_FLT_STACK_CHECK          'ErrStr = "由于浮点运算，堆栈上溢或下溢。"
'      Case EXCEPTION_FLT_UNDERFLOW            'ErrStr = "浮点运算的指数小于相应类型所允许的大小。"
'      Case EXCEPTION_ILLEGAL_INSTRUCTION      'ErrStr = "线程试图执行无效指令。"
'      Case EXCEPTION_IN_PAGE_ERROR            'ErrStr = "该线程试图访问一个不存在的页面，系统无法加载该页面。例如，如果通过网络运行程序时网络连接丢失，可能会发生此异常。"
'      Case EXCEPTION_INT_DIVIDE_BY_ZERO       'ErrStr = "线程尝试将整数值除以零的整数除数。"
'      Case EXCEPTION_INT_OVERFLOW             'ErrStr = "整数运算的结果导致对结果的最高有效位进行进位。"
'      Case EXCEPTION_INVALID_DISPOSITION      'ErrStr = "异常处理程序将无效处置返回给异常调度程序。使用诸如C之类的高级语言的程序员应该永远不会遇到此异常。"
'      Case EXCEPTION_NONCONTINUABLE_EXCEPTION 'ErrStr = "发生不可连续的异常后，线程尝试继续执行。"
'      Case EXCEPTION_PRIV_INSTRUCTION         'ErrStr = "线程试图执行一条指令，该指令在当前机器模式下是不允许的。"
'      Case EXCEPTION_SINGLE_STEP              'ErrStr = "跟踪陷阱或其他单指令机制表明已执行了一条指令。"
'      Case EXCEPTION_STACK_OVERFLOW           'ErrStr = "线程耗尽了其堆栈。"
'      Case Else
'         Return 0  ' 实际使用中，发现 系统内部使用 未知消息（自定义消息），必须 直接返回，让系统自动处理
'         '当然还有其它DLL也可能使用 VEH，发生崩溃时，不是在自己写的EXE范围内，也可以直接返回。
'   End Select
'   Static ExceptionCode As UInteger '有的系统会1次崩溃发生2次相同事件，必须过滤1个
'   if ExceptionCode = excp.ExceptionRecord->ExceptionCode Then Return 0   
'   ExceptionCode = excp.ExceptionRecord->ExceptionCode
'   
'   Dim zz As ULong  
'   Dim ee As uInteger = Get_Pro_Mo_Ad(GetCurrentProcessId(), App.EXEName, zz)
'   if excp.ExceptionRecord->ExceptionAddress< ee OrElse excp.ExceptionRecord->ExceptionAddress> ee+zz Then Return 0 '跳过非自己模块
'   ee = Cast(uInteger, @excp) '显示提示BUG窗口
'   BugReport.Show, 1, Cast(Integer, @ee) '传递 ee 指针，可以方便返回值来判断。
'   '根据 ee 返回，判断是否继续执行
'   if ee = 0 Then ExceptionCode = 0 : Return -1 '继续执行
'   if ee = 1 Then ExceptionCode = 0 : Return 0 'windows 默认
'   Return 1  '告诉系统结束软件
'End Function


#Include Once "win\tlhelp32.bi"
Sub BugReport_WM_Create(hWndForm As hWnd, UserData As Integer)  '完成创建窗口及所有的控件后，此时窗口还未显示。注：自定义消息里 WM_Create 此时还未创建控件和初始赋值。
   Dim nDC As HDC = GetDC(null)
   Static jj As Long
   jj += 1
   if jj = 1 Then
      Me.Tag = NowString(1)
      '截图--------------
      Dim nDC As HDC = GetDC(null)
      Dim memBM As HBITMAP, j_Bmp As HBITMAP
      Dim As Long cw=GetSystemMetrics(SM_CXSCREEN) ,ch = GetSystemMetrics(SM_CYSCREEN)
      memBM = CreateCompatibleBitmap(nDC, cw, ch)  '// 创建一个兼容的位图
      Dim memDC As HDC = CreateCompatibleDC(nDC) '内存DC
      SelectObject(memDC, memBM)  '// 将位图选择到兼容的设备上下文中
      BitBlt memDC, 0, 0, cw, ch, nDC, 0, 0, SrcCopy '复制原图
      AfxGdipSaveHBITMAPToFile(memBM, App.Path & "bug" & Me.Tag & ".jpg", "image/jpeg")
      DeleteDC memDC
      DeleteObject memBM
      ReleaseDC null, nDC
   Else
      Text3.Enabled = False 
      Text1.Enabled = False 
      Command1.Enabled = False 
      Text1.Text = "第 " & jj & " 次发生崩溃，继续执行后再次发生崩溃，失去了提交BUG的意义，请关闭软件重开吧。"
      Text3.Text = "又发生崩溃了，老表，还是关软件重启吧。"
   End if
End Sub
Sub BugReport_Shown(hWndForm As hWnd, UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
   Me.Caption = App.ProductName & " - 出错报告！"
   Static hIcon As HICON                      ' // Icon handle
   If hIcon = 0 Then hIcon = LoadIcon(Null, IDI_ERROR)
   If hIcon Then
      SendMessage(hWndForm, WM_SETICON, ICON_SMALL, Cast(lParam, hIcon))
      SendMessage(hWndForm, WM_SETICON, ICON_BIG, Cast(lParam, hIcon))
   End If
   if UserData = 0 Then Return
   Me.UserData(0) = UserData
   dim excp As EXCEPTION_POINTERS Ptr = Cast(Any Ptr, *CPtr(UInteger Ptr, UserData))
   Dim bug As String = "应用程序名:    " & App.EXEName & vbCrLf
   bug &= "应用程序版本:  " & App.ProductMajor & "." & App.ProductMinor & "." & App.ProductRevision & "." & App.ProductBuild & vbCrLf
   Dim gzmk As String, AllMode As String, pianyi As UInteger, gzmkbb As String
   Dim ExceptionAddress As UInteger = Cast(UInteger, excp->ExceptionRecord->ExceptionAddress)
   Dim I as Long
   Dim Mode as MODULEENTRY32
   Dim mSnapshot as HANDLE
   
   '----------------查找进程的执行程序的路径-----------------------
   '通过模块快照，获得进程的模块快照句柄
   mSnapshot = CreateToolhelp32Snapshot(&H8, GetCurrentProcessId()) 'Const TH32CS_SNAPmodule = &H8
   If mSnapshot Then
      Mode.dwSize = SizeOf(MODULEENTRY32) '初始化结构mo的大小
      
      '用该进程第1个模块的szExePath字段，作为进程的程序路径
      If Module32First(mSnapshot, @Mode) Then
         AllMode &= CWSTRtoString(Mode.szExePath) & vbCrLf
         if ExceptionAddress > Cast(UInteger, Mode.modBaseAddr) And ExceptionAddress < Cast(UInteger, Mode.modBaseAddr) + Cast(UInteger, Mode.modBaseSize) Then
            gzmk = CWSTRtoString(Mode.szModule)
            gzmkbb = GetVersionInfo(Mode.szExePath)
            pianyi = ExceptionAddress - Cast(UInteger, Mode.modBaseAddr)
         End if
         Do While Module32Next(mSnapshot, @Mode) <> 0
            i += 1
            AllMode &= CWSTRtoString(Mode.szExePath) & vbCrLf
            if pianyi = 0 Then
               if ExceptionAddress > Cast(UInteger, Mode.modBaseAddr) And ExceptionAddress < Cast(UInteger, Mode.modBaseAddr) + Cast(UInteger, Mode.modBaseSize) Then
                  gzmk = CWSTRtoString(Mode.szModule)
                  gzmkbb = GetVersionInfo(Mode.szExePath)
                  pianyi = ExceptionAddress - Cast(UInteger, Mode.modBaseAddr)
               End if
            End if
         Loop 'Until Module32Next(mSnapshot, Mode) = 0
      End If
      
   End If
   CloseHandle(mSnapshot)   '关闭模块快照句柄
   
   '32位 寄存器 excp.ContextRecord->Eax Ebx Ecx Edx Ebp Esi Edi Eip
   '62位 寄存器 excp.ContextRecord->Rax Rbx Rcx Rdx Rbp Rsi Rdi Rip Rsp R8 R9 R10 R11 R12 R13 R14 R15
   
   bug &= "故障模块名称:  " & gzmk & vbCrLf
   bug &= "故障模块版本:  " & gzmkbb & vbCrLf
   
   Dim ErrStr As String
   Select Case excp->ExceptionRecord->ExceptionCode   '发生异常的原因。这是由硬件异常生成的代码，或在RaiseException函数中为软件生成的异常指定的代码 。
      Case EXCEPTION_ACCESS_VIOLATION
         ErrStr = "线程试图读取或写入对其没有适当访问权限的虚拟地址。"
      Case EXCEPTION_ARRAY_BOUNDS_EXCEEDED
         ErrStr = "线程尝试访问超出范围的数组元素，并且基础硬件支持范围检查。"
      Case EXCEPTION_BREAKPOINT
         ErrStr = "遇到断点。"
      Case EXCEPTION_DATATYPE_MISALIGNMENT
         ErrStr = "线程试图读取或写入在不提供对齐方式的硬件上未对齐的数据。例如，必须在2字节边界上对齐16位值；4字节边界上的32位值，依此类推。"
      Case EXCEPTION_FLT_DENORMAL_OPERAND
         ErrStr = "浮点运算中的操作数之一是非正规的。非标准值是一个太小而无法表示为标准浮点值的值。"
      Case EXCEPTION_FLT_DIVIDE_BY_ZERO
         ErrStr = "线程试图将浮点值除以零的浮点除数。"
      Case EXCEPTION_FLT_INEXACT_RESULT
         ErrStr = "浮点运算的结果不能完全表示为小数。"
      Case EXCEPTION_FLT_INVALID_OPERATION
         ErrStr = "此异常表示此列表中未包含的任何浮点异常。"
      Case EXCEPTION_FLT_OVERFLOW
         ErrStr = "浮点运算的指数大于相应类型所允许的大小。"
      Case EXCEPTION_FLT_STACK_CHECK
         ErrStr = "由于浮点运算，堆栈上溢或下溢。"
      Case EXCEPTION_FLT_UNDERFLOW
         ErrStr = "浮点运算的指数小于相应类型所允许的大小。"
      Case EXCEPTION_ILLEGAL_INSTRUCTION
         ErrStr = "线程试图执行无效指令。"
      Case EXCEPTION_IN_PAGE_ERROR
         ErrStr = "该线程试图访问一个不存在的页面，系统无法加载该页面。例如，如果通过网络运行程序时网络连接丢失，可能会发生此异常。"
      Case EXCEPTION_INT_DIVIDE_BY_ZERO
         ErrStr = "线程尝试将整数值除以零的整数除数。"
      Case EXCEPTION_INT_OVERFLOW
         ErrStr = "整数运算的结果导致对结果的最高有效位进行进位。"
      Case EXCEPTION_INVALID_DISPOSITION
         ErrStr = "异常处理程序将无效处置返回给异常调度程序。使用诸如C之类的高级语言的程序员应该永远不会遇到此异常。"
      Case EXCEPTION_NONCONTINUABLE_EXCEPTION
         ErrStr = "发生不可连续的异常后，线程尝试继续执行。"
      Case EXCEPTION_PRIV_INSTRUCTION
         ErrStr = "线程试图执行一条指令，该指令在当前机器模式下是不允许的。"
      Case EXCEPTION_SINGLE_STEP
         ErrStr = "跟踪陷阱或其他单指令机制表明已执行了一条指令。"
      Case EXCEPTION_STACK_OVERFLOW
         ErrStr = "线程耗尽了其堆栈。"
      Case Else
         ErrStr = "未知"
   End Select
   
   bug &= "异常代码:      " & Hex(excp->ExceptionRecord->ExceptionCode) & "  " & ErrStr & vbCrLf
   bug &= "异常偏移:      " & Hex(pianyi, 8) & vbCrLf
   
   #IfDef __FB_64BIT__
   bug &= "寄存器值:      Rax=" & Hex(excp->ContextRecord->Rax) 
   if excp->ContextRecord->Rax>&H10000  Then bug &= " [Rax]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rax))
   bug &= " Rbx=" & Hex(excp->ContextRecord->Rbx) 
   if excp->ContextRecord->Rbx>&H10000 Then bug &= " [Rbx]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rbx))
   bug &= " Rcx=" & Hex(excp->ContextRecord->Rcx) 
   if excp->ContextRecord->Rcx>&H10000  Then bug &= " [Rcx]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rcx))
   bug &= " Rdx=" & Hex(excp->ContextRecord->Rdx) 
   if excp->ContextRecord->Rdx>&H10000  Then bug &= " [Rdx]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rdx))
   bug &= " Rbp=" & Hex(excp->ContextRecord->Rbp) 
   if excp->ContextRecord->Rbp>&H10000  Then bug &= " [Rbp]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rbp))
   bug &= " Rsi=" & Hex(excp->ContextRecord->Rsi) 
   if excp->ContextRecord->Rsi>&H10000  Then bug &= " [Rsi]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rsi))
   bug &= " Rdi=" & Hex(excp->ContextRecord->Rdi) 
   if excp->ContextRecord->Rdi>&H10000  Then bug &= " [Rdi]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp->ContextRecord->Rdi))
   bug &= " Rip=" & Hex(excp->ContextRecord->Rip) & vbCrLf
   #Else
   bug &= "寄存器值:      Eax=" & Hex(excp->ContextRecord->Eax)
   if excp->ContextRecord->Eax>&H10000  Then bug &= " [Eax]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Eax))
   bug &= " Ebx=" & Hex(excp->ContextRecord->Ebx)
   if excp->ContextRecord->Ebx>&H10000  Then bug &= " [Ebx]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Ebx))
   bug &= " Ecx=" & Hex(excp->ContextRecord->Ecx)
   if excp->ContextRecord->Ecx>&H10000  Then bug &= " [Ecx]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Ecx))
   bug &= " Edx=" & Hex(excp->ContextRecord->Edx)
   if excp->ContextRecord->Edx>&H10000  Then bug &= " [Edx]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Edx))
   bug &= " Ebp=" & Hex(excp->ContextRecord->Ebp)
   if excp->ContextRecord->Ebp>&H10000  Then bug &= " [Ebp]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Ebp))
   bug &= " Esi=" & Hex(excp->ContextRecord->Esi)
   if excp->ContextRecord->Esi>&H10000  Then bug &= " [Esi]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Esi))
   bug &= " Edi=" & Hex(excp->ContextRecord->Edi)
   if excp->ContextRecord->Edi>&H10000  Then bug &= " [Edi]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp->ContextRecord->Edi))
   bug &= " Eip=" & Hex(excp->ContextRecord->Eip) & vbCrLf
   #endif
   
   Dim vi as OSVERSIONINFO
   vi.dwOsVersionInfoSize = SizeOf(OSVERSIONINFO)
   GetVersionEx @vi
   bug &= " OS 版本:      " & vi.dwMajorVersion & "." & vi.dwMinorVersion & "." & vi.dwBuildNumber & vbCrLf
   bug &= "区域设置 ID:   " & GetUserDefaultLangID & vbCrLf
   bug &= "模块列表:   ------------------------------------------" & vbCrLf & AllMode
   bug &= "进程列表:   ------------------------------------------" & vbCrLf
   AllMode = ""
   Dim Proc as PROCESSENTRY32
   Dim hSnap As HANDLE = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, Null)
   if hSnap Then
      Proc.dwSize = SizeOf(PROCESSENTRY32)
      dim p As Integer = Process32First(hSnap, @Proc)
      While p
         AllMode &= CWSTRtoString(Proc.szExeFile) & vbCrLf
         p = Process32Next(hSnap, @Proc)
      Wend
      CloseHandle hSnap
   End if
   Text2.Text = bug & AllMode
   'SaveFileStr App.Path & "bug" & Me.Tag & ".txt", bug & AllMode
   
   
End Sub

Sub BugReport_Command3_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Me.Height = AfxScaleY(620)
   Label6.Visible = False 
   Command3.Visible = False 
   Text2.Top = AfxScaleY(280)
      
End Sub

Function BugReport_WM_Close(hWndForm As hWnd) As LResult  '即将关闭窗口，返回非0可阻止关闭
   if Me.UserData(1) Then Return 0
   Dim UserData As Integer = Me.UserData(0)
   *CPtr(Integer Ptr, UserData) =1
'   Select Case MsgBox(hWndForm, "关闭本窗口后将会立即结束软件，你真的要结束软件吗？", _
'            MB_YESNO Or MB_ICONQUESTION Or MB_DEFBUTTON2 Or MB_APPLMODAL)
'      Case IDYES
'      Case IDNO
'         Return TRUE
'   End Select
'   Function = FALSE ' 如果想阻止窗口关闭，则应返回 TRUE 。
End Function

Sub BugReport_Command2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Dim UserData As Integer = Me.UserData(0)
   dim excp As EXCEPTION_POINTERS Ptr = Cast(Any Ptr, *CPtr(UInteger Ptr, UserData))
   If 2 = 1 Then '为了获取  Hook_API_SizeOfCode 
      Hook_API("", "",0,0) 
   End If    
   #IfDef __FB_64BIT__
   excp->ContextRecord->Rip +=Hook_API_SizeOfCode(Cast(Any Ptr,excp->ContextRecord->Rip))
   #Else
   excp->ContextRecord->Eip +=Hook_API_SizeOfCode(Cast(Any Ptr, excp->ContextRecord->Eip))
   #endif   
   
   *CPtr(Integer Ptr, UserData) = 0
   Me.UserData(1) = 1
   Me.Close 
   
End Sub

Sub BugReport_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Me.UserData(2) = 0
   Me.Enabled = False 
   Command1.Enabled = False 
   
   Dim tt As Double = Timer
   
   Threaddetach ThreadCreate(Cast(Any Ptr,@提交BUG),0) '经典调用方法
   Do 
      Sleep 100
      AfxDoEvents hWndForm
      if Me.UserData(2) Then Exit Do
      Command1.Caption = Format(Timer - tt,"0.00")
   Loop 
   
   MsgBox(hWndForm, "已经提交BUG完成，点【确定】后软件将会直接退出。" & vbCrLf & vbCrLf & _
   "非常感谢你提交BUG，勇芳会努力检查，尽快找出" & vbCrLf & _
   "原因来修复BUG，查找BUG非常困难，需要很多时间，" & vbCrLf & _
   "请谅解，关注勇芳网站，软件更新后会及时发布的。", _
      MB_OK Or MB_ICONWARNING Or MB_DEFBUTTON1 Or MB_APPLMODAL)
   
   Me.UserData(1) = 1
   Me.Close
End Sub

Sub 提交BUG(aa As Any Ptr)
   Dim sj As String = Me.Tag
   Dim fen As String = App.Path & "bug" & sj & ".jpg"
   
   if AfxFileExists(fen) Then
      Dim gg As String ="jpg|" & GetFileStr(fen)
'   Http_Post("http://***.***.com/***.php", gg)
      AfxKill fen
   End if
   fen = vbCrLf & Text2.Text & vbCrLf & "联系方式：" & Text3.Text & vbCrLf
   if Text1.UserData(0) Then
      fen &= "详细描述：" & vbCrLf & Text1.Text
   End if
   Dim gg As String = "txt|" & fen

'   Http_Post("http://***.***.com/***.php", gg)
   
   Me.UserData(2) = 1
End Sub

Sub BugReport_Text1_EN_SetFocus(hWndForm As hWnd, hWndControl As hWnd)  '得到输入焦点
   if Text1.UserData(0) = 0 Then 
      Text1.UserData(0) = 1
      Text1.Text = ""
      Text1.ForeColor =GetSysColor(COLOR_WINDOWTEXT)
   End if 
End Sub

Sub BugReport_Text1_EN_KillFocus(hWndForm As hWnd, hWndControl As hWnd)  '失去输入焦点
   if Text1.Text = "" Then 
      Text1.UserData(0) = 0
      Text1.Text = "在这里输入发生BUG前的状态，描述引发BUG前的操作，以助勇芳能查明原因而可以修复BUG。查BUG是非常困难的事情，请详细描述才有可能查到BUG而修复它。"
      Text1.ForeColor =GetSysColor(COLOR_BTNSHADOW)
   End if
End Sub














